1 Primera anàlisi descriptiva i de correlacions

En aquest treball fem servir les dades German Credit. Aquest joc de dades classifica les persones segons el risc que tenen a l’hora de demanar un crèdit.

En aquest apartat, es fa una primera anàlisi de les dades. Es vol veure com són les dades i entendre-les el millor possible.

1.1 Descripció dels atributs

A continuació es mostra una taula amb els atributs del conjunt de dades i la seua explicació:

Atribut Descripció
checking_balance Estat del compte corrent
months_loan_duration Durada del préstec en mesos
credit_history Informació sobre crèdits anteriors
purpose Propòsit del prèstec
amount Import del crèdit
savings_balance Quantitat de diners al compte d’estalvis
employment_length Temps treballats en anys
installment_rate Taxa de fraccionament en percentatge de la renda disponible
personal_status Estat personal (divorciat, casat, solter) i sexe (masculí, femení)
other_debtors Altres deutors o fiadors
residence_history Des de quan viu en la residència actual
property Informació sobre les pròpietats i bens
age Edat
installment_plan Altres plans de fraccionament
housing Habitatge
existing_credits Nombre de crèdits existents en aquest banc
default Indica l’impagament de crèdits
dependents Nombre de persones obligades a fer el manteniment
telephone Informació de si té el telèfon registrat al banc o no
foreign_worker Informació de si és un treballador estranger
job Informació bàsica del tipus de feina

1.2 Exploració de la base de dades

Comencem carregant les dades en un Data Frame. A més, també fem servir la funció attach(...) per a poder accedir als objectes del Data Frame només escrivint el seu nom:

df <- read.csv("data/credit.csv", header = TRUE, sep = ",")
df_original <- df
attach(df)

Donem una ullada a l’estructura de les dades:

str(df)
## 'data.frame':    1000 obs. of  21 variables:
##  $ checking_balance    : chr  "< 0 DM" "1 - 200 DM" "unknown" "< 0 DM" ...
##  $ months_loan_duration: int  6 48 12 42 24 36 24 36 12 30 ...
##  $ credit_history      : chr  "critical" "repaid" "critical" "repaid" ...
##  $ purpose             : chr  "radio/tv" "radio/tv" "education" "furniture" ...
##  $ amount              : int  1169 5951 2096 7882 4870 9055 2835 6948 3059 5234 ...
##  $ savings_balance     : chr  "unknown" "< 100 DM" "< 100 DM" "< 100 DM" ...
##  $ employment_length   : chr  "> 7 yrs" "1 - 4 yrs" "4 - 7 yrs" "4 - 7 yrs" ...
##  $ installment_rate    : int  4 2 2 2 3 2 3 2 2 4 ...
##  $ personal_status     : chr  "single male" "female" "single male" "single male" ...
##  $ other_debtors       : chr  "none" "none" "none" "guarantor" ...
##  $ residence_history   : int  4 2 3 4 4 4 4 2 4 2 ...
##  $ property            : chr  "real estate" "real estate" "real estate" "building society savings" ...
##  $ age                 : int  67 22 49 45 53 35 53 35 61 28 ...
##  $ installment_plan    : chr  "none" "none" "none" "none" ...
##  $ housing             : chr  "own" "own" "own" "for free" ...
##  $ existing_credits    : int  2 1 1 1 2 1 1 1 1 2 ...
##  $ default             : int  1 2 1 1 2 1 1 1 1 2 ...
##  $ dependents          : int  1 1 2 2 2 2 1 1 1 1 ...
##  $ telephone           : chr  "yes" "none" "none" "none" ...
##  $ foreign_worker      : chr  "yes" "yes" "yes" "yes" ...
##  $ job                 : chr  "skilled employee" "skilled employee" "unskilled resident" "skilled employee" ...

Veiem que hi ha 1000 registres i 21 variables. Hi ha variables numèriques i categòriques.

Es pot observar que l’atribut personal_status és una barreja entre la situació familiar (solter, casat, divorciat) i entre el sexe de la persona (masculí, femení). Decidim crear una nova variable sex. Sorprèn veure que en el cas que la persona sigui de sexe femení no es tinguin dades sobre el seu estat familiar, però, en canvi, si és de sexe masculí sí.

df$sex <- gsub("(single )?(divorced )?(married )?", "", df$personal_status)
unique(df$sex)
## [1] "male"   "female"

Les variables categòriques s’han carregat com a caràcters, però volem que siguin factors. Això vol dir que cal convertir les variables amb tipus caràcter a tipus factor. També cal convertir la variable objectiu default a factor.

Per fer-ho fem servir la funció fem servir el seguent codi:

# Convertim les variables categòriques a factor
df[sapply(df, is.character)] <- lapply(
  df[sapply(df, is.character)],
  as.factor
)
# Convertim la variable default a factor
df$default <- cut(df$default, 2, labels = c("No default", "Default"))

Un cop hem obtingut les variables amb el tipus que volem, ens interessa conèixer si contenen molts valors buits. Ho fem amb la següent comanda que mostra les variables ordenades per la proporció de valors buits (NA i caràcters buits):

sort(colMeans(is.na(df) | df == ""), decreasing = TRUE)
##     checking_balance months_loan_duration       credit_history 
##                    0                    0                    0 
##              purpose               amount      savings_balance 
##                    0                    0                    0 
##    employment_length     installment_rate      personal_status 
##                    0                    0                    0 
##        other_debtors    residence_history             property 
##                    0                    0                    0 
##                  age     installment_plan              housing 
##                    0                    0                    0 
##     existing_credits              default           dependents 
##                    0                    0                    0 
##            telephone       foreign_worker                  job 
##                    0                    0                    0 
##                  sex 
##                    0

Per sort, cap dels atributs conté registres buits.

1.3 Visualització

Per a conèixer millor les dades, disposem de les eines de visualització.

Primer de tot, carreguem els paquets que farem servir per a generar les gràfiques. Aquest són ggplot2, ggalt, ggtext, ggpubr, grid, gridExtra i C50:

packages <- c("ggplot2", "ggalt", "ggtext", "ggpubr", "grid", "gridExtra")

not_installed <- packages[!(packages %in% installed.packages())]
if (length(not_installed) > 0) {
  install.packages(not_installed, repos = "http:/cran.us.r-project.org")
}
lapply(packages, library, character.only = TRUE)
## [[1]]
## [1] "ggplot2"   "stats"     "graphics"  "grDevices" "utils"     "datasets" 
## [7] "methods"   "base"     
## 
## [[2]]
## [1] "ggalt"     "ggplot2"   "stats"     "graphics"  "grDevices" "utils"    
## [7] "datasets"  "methods"   "base"     
## 
## [[3]]
##  [1] "ggtext"    "ggalt"     "ggplot2"   "stats"     "graphics"  "grDevices"
##  [7] "utils"     "datasets"  "methods"   "base"     
## 
## [[4]]
##  [1] "ggpubr"    "ggtext"    "ggalt"     "ggplot2"   "stats"     "graphics" 
##  [7] "grDevices" "utils"     "datasets"  "methods"   "base"     
## 
## [[5]]
##  [1] "grid"      "ggpubr"    "ggtext"    "ggalt"     "ggplot2"   "stats"    
##  [7] "graphics"  "grDevices" "utils"     "datasets"  "methods"   "base"     
## 
## [[6]]
##  [1] "gridExtra" "grid"      "ggpubr"    "ggtext"    "ggalt"     "ggplot2"  
##  [7] "stats"     "graphics"  "grDevices" "utils"     "datasets"  "methods"  
## [13] "base"

1.3.1 Anàlisi univariant

Analitzem les diferents variables del Data Frame, principalment volem conèixer la seua distribució.

Generem histogrames per a veure com estan distribuïdes:

grid.newpage()
plots <- list()
i <- 1

for (attr in colnames(df)) {
  plot <- ggplot(df, aes_string(x = attr)) +
    geom_histogram(stat = "count") +
    labs(title = attr, x = "") +
    theme(axis.text.x = element_text(angle = 30, hjust = 1, vjust = 0.5)) +
    theme(plot.margin = unit(c(0.25, 0.25, 0.25, 0.25), "cm"))
  plots[[i]] <- plot
  i <- i + 1
}
grid.arrange(grobs = plots)

El primer que podem observar és que generalment el crèdit es torna (“No default”), tot i això, el nombre d’impagaments (“Default”) és bastant elevat.

També veiem com els motius més habituals a l’hora de demanar un préstec són comprar un cotxe (nou o de segona mà), un televisor o mobles nous.

Es pot veure que la gran majoria de la gent té menys de 100 DM al seu compte d’estalvis. A més no tenen altres deutors i que acostumen a tenir només un crèdit.

Com és lògic, hi ha poca gent que ha aconseguit un crèdit sense tenir feina. El més comú és haver estat treballant entre 1 i 4 anys. A més, la gent acostuma a ser treballadors amb grans habilitats.

Els homes solters són el perfil que més crèdits demana. Això sembla lògic per què hi ha més homes solters que casats o divorciats. El que sorprén més, és que sent el 50 % de la societat, hi hagi moltes menys dones amb un crèdit.

El més habitual és que les persones visquin en una casa de la seua propietat, a més, molts d’ells porten 4 anys vivint-hi.

Finalment, una variable que ens sorprèn molt és la de foreign_worker, aquesta indica que quasi tots els treballadors són estrangers. Això ens indica que, o bé les dades són incorrectes, o aquest banc només ha proporcionat dades de clients estrangers.

També podem generar gràfiques Box Plot que ens ajudin a entendre la distribució de les variables numèriques:

boxplot(df$amount)

boxplot(df$age)

boxplot(df$months_loan_duration)

if (!require("dplyr")) {
  install.packages("dplyr", repos = "http:/cran.us.r-project.org")
}
library("dplyr")

remove_attr <- c(
  "amount",
  "age",
  "months_loan_duration",
  "default"
)
df_delete <- select(df, !all_of(remove_attr))
boxplot(select_if(df_delete, is.numeric))

Les variables numèriques tenen diverses escales, és per això, que no té cap sentit mostrar-les en una sola gràfica.

Veiem que la mediana de l’import del crèdit és de 2.320. La gran majoria d’usuaris en té menys de 3.972, però més de 1.366. I que hi ha alguns casos que n’han demanat més de 10.000, però es poden considerar casos extrems.

Pel que fa a l’edat, veiem que la majoria de persones que han demanat un préstec tenen entre 27 i 42 anys. La mediana de l’edat és de 33 anys. Veiem com hi ha persones que amb més de 60 anys demanen crèdits, però no és gens habitual.

Els crèdits acostumen a durar entre 12 i 24 mesos. La mitjana està en 20 mesos. Però en casos excepcionals, n’hi ha que s’allarguen més de 40 mesos.

Es pot veure com installment_rate i residence_history tenen una gràfica molt similar, així que és possible que estiguin relacionades. La mediana se situa a 3, però a l’histograma veiem que el més usual és tenir una taxa de fraccionament de 4 i fer 4 anys que es viu a la residència actual.

És estrany veure que el màxim d’anys viscuts en la mateixa casa sigui de 4, però no tenim forma d’esbrinar si es tracta d’un error. Així que assumirem que les dades són correctes.

Veiem com la gent no acostuma a tenir més de 2 crèdits, de fet, el més normal és tenir-ne només 1.

Pel que fa a la variable dependents, aquest tipus de gràfica no ens aporta gaire, ja que, només conté 1 o 2. Però, veiem que la majoria de vegades només una persona és l’obligada a fer el manteniment.

1.3.2 Anàlisi de correlacions

En aquesta secció volem estudiar la correlació que hi ha entre les diferents variables.

Per a fer-ho, fem servir una matriu de correlacions. Aquesta ens indica amb un cercle de color blau si hi ha una forta correlació positiva, i amb un cercle de color vermell ens indica si hi ha una correlació negativa. Si el cercle és petit i de color blanc, llavors vol dir que no hi ha cap mena de correlació entre totes dos variables.

if (!require("corrplot")) {
  install.packages("corrplot", repos = "http:/cran.us.r-project.org")
}
library("corrplot")

# visualize correlation matrix
corrplot(cor(select_if(df, is.numeric)))

Veiem que hi ha una correlació positiva entre la quantitat del crèdit i entre la seua duració. És totalment lògic que sigui així, ja que, com més diners demanes, més es tarda a tornar-los.

Pel que fa a la resta de variables numèriques, no s’observa cap altre tipus de correlació.

1.3.3 Anàlisi gràfica respecte a default

Ara volem estudiar la relació de cada una de les variables respecte a la nostra variable objectiu default.

Per això, pintem els histogrames però classificades per l’impagament del crèdit. En aquestes gràfiques “No default” és el color negre i “Default” és el color grana:

grid.newpage()
plots <- list()
i <- 1

for (attr in colnames(df)) {
  if (attr == "default") next

  plot <- ggplot(df, aes_string(x = attr, fill = factor(default))) +
    geom_histogram(stat = "count") +
    scale_fill_manual(values = c("#030d0b", "#ae4e38")) +
    labs(title = attr, x = "") +
    theme(axis.text.x = element_text(angle = 30, hjust = 1, vjust = 0.5)) +
    theme(plot.margin = unit(c(0.25, 0.25, 0.25, 0.25), "cm"))
  plots[[i]] <- plot
  i <- i + 1
}
grid.arrange(grobs = plots)

Es pot observar com el nombre d’impagaments és més alt si el motiu de sol·licitar-lo és comprar-se un cotxe nou.

També veiem com la taxa d’impagaments és superior en aquells que fa menys d’un any que treballen respecte dels que en porten més de set.

Per seguir indagant en aquestes dades, podem generar les gràfiques de les taules de contingència. Aquestes ens mostren el percentatge de defaults que hi ha en cada categoria.

Primer hem de crear les taules (s’ha intentat fer tot aquest procés en un loop, però no s’ha aconseguit):

table_D1 <- table(df$checking_balance, df$default)
table_D2 <- table(df$credit_history, df$default)
table_D3 <- table(df$purpose, df$default)
table_D4 <- table(df$amount, df$default)
table_D5 <- table(df$savings_balance, df$default)
table_D6 <- table(df$employment_length, df$default)
table_D7 <- table(df$installment_rate, df$default)
table_D8 <- table(df$personal_status, df$default)
table_D9 <- table(df$other_debtors, df$default)
table_D10 <- table(df$residence_history, df$default)
table_D11 <- table(df$property, df$default)
table_D12 <- table(df$age, df$default)
table_D13 <- table(df$installment_plan, df$default)
table_D14 <- table(df$housing, df$default)
table_D15 <- table(df$existing_credits, df$default)
table_D16 <- table(df$dependents, df$default)
table_D17 <- table(df$telephone, df$default)
table_D18 <- table(df$foreign_worker, df$default)
table_D19 <- table(df$job, df$default)
table_D20 <- table(df$sex, df$default)

Ara mostrem les gràfiques:

par(mfrow = c(7, 3))

plot(table_D1, col = c("#030d0b", "#ae4e38"), main = "Checking balance")
plot(table_D2, col = c("#030d0b", "#ae4e38"), main = "Credit history")
plot(table_D3, col = c("#030d0b", "#ae4e38"), main = "Purpose")
plot(table_D4, col = c("#030d0b", "#ae4e38"), main = "Amount")
plot(table_D5, col = c("#030d0b", "#ae4e38"), main = "Savings Balance")
plot(table_D6, col = c("#030d0b", "#ae4e38"), main = "Employement Lenght")
plot(table_D7, col = c("#030d0b", "#ae4e38"), main = "Installment Rate")
plot(table_D8, col = c("#030d0b", "#ae4e38"), main = "Personal Status")
plot(table_D9, col = c("#030d0b", "#ae4e38"), main = "Other Debtors")
plot(table_D10, col = c("#030d0b", "#ae4e38"), main = "Residence History")
plot(table_D11, col = c("#030d0b", "#ae4e38"), main = "Property")
plot(table_D12, col = c("#030d0b", "#ae4e38"), main = "Age")
plot(table_D13, col = c("#030d0b", "#ae4e38"), main = "Installment Plan")
plot(table_D14, col = c("#030d0b", "#ae4e38"), main = "Housing")
plot(table_D15, col = c("#030d0b", "#ae4e38"), main = "Existing Credits")
plot(table_D16, col = c("#030d0b", "#ae4e38"), main = "Dependents")
plot(table_D17, col = c("#030d0b", "#ae4e38"), main = "Telephone")
plot(table_D18, col = c("#030d0b", "#ae4e38"), main = "Foreign worker")
plot(table_D19, col = c("#030d0b", "#ae4e38"), main = "Job")
plot(table_D20, col = c("#030d0b", "#ae4e38"), main = "Sex")

Podem veure que en general no hi ha gaires diferències entre els valors de les variables. Tot i això, se’n poden destacar algunes.

Els treballadors estrangers tenen un percentatge més alt d’impagaments que els treballadors locals.

Es pot afirmar que conèixer el tipus de propietat on viu la persona és important. Sobretot si viu en un real state.

Les persones més grans acostumen a tornar més els crèdits que les persones joves.

Els estalvis i els diners al compte corrent i l’historial de crèdits també demostren grans diferències.

Finalment, basant-nos en l’anàlisi feta fins ara, es pot concloure que les variables que semblen més importants seran:

  • checking_balance
  • credit_history
  • purpose
  • savings_balance
  • employement_length
  • property
  • age
  • foreign_worker

1.4 Preparació de les dades

L’objectiu principal d’aquest treball és analitzar les dades utilitzant un arbre de decisió. Per a fer-ho, abans hem de dividir les dades en dos subconjunts. El conjunt d’entrenament i el de prova. El primer ens serveix per a construir el model, i el segon per a comprovar-ne la qualitat.

La quantitat de dades per a cada un dels conjunts pot variar, però s’acostuma a fer servir \(2/3\) per al conjunt d’entrenament i \(1/3\) per al conjunt de proves.

També hem de separar la variable objectiu de la resta. En el nostre cas, la variable que volem predir és default:

packages <- c("dplyr")

not_installed <- packages[!(packages %in% installed.packages())]
if (length(not_installed) > 0) {
  install.packages(not_installed, repos = "http:/cran.us.r-project.org")
}
lapply(packages, library, character.only = TRUE)
## [[1]]
##  [1] "corrplot"  "dplyr"     "gridExtra" "grid"      "ggpubr"    "ggtext"   
##  [7] "ggalt"     "ggplot2"   "stats"     "graphics"  "grDevices" "utils"    
## [13] "datasets"  "methods"   "base"
y <- df$default

remove_attr <- c("default")
X <- select(df, !all_of(remove_attr))

Ara ja podem dividir el dataset:

set.seed(1899)
split_prop <- 3

indexes <- sample(1:nrow(df),
  size = floor(((split_prop - 1) / split_prop) * nrow(df))
)

train_X <- X[indexes, ]
train_y <- y[indexes]
test_X <- X[-indexes, ]
test_y <- y[-indexes]

Després d’haver creat els conjunts hem de fer una anàlisi de dades mínim per a assegurar-nos de no obtenir classificadors esbiaixats pels valors que conté cada mostra. En aquest cas, verifiquem que la proporció d’impagaments és més o menys constant en els dos conjunts:

summary(train_X)
##    checking_balance months_loan_duration                credit_history
##  < 0 DM    :187     Min.   : 4.00        critical              :202   
##  > 200 DM  : 41     1st Qu.:12.00        delayed               : 56   
##  1 - 200 DM:181     Median :18.00        fully repaid          : 29   
##  unknown   :257     Mean   :20.81        fully repaid this bank: 34   
##                     3rd Qu.:24.00        repaid                :345   
##                     Max.   :72.00                                     
##                                                                       
##        purpose        amount           savings_balance  employment_length
##  radio/tv  :193   Min.   :  250   < 100 DM     :400    > 7 yrs   :161    
##  car (new) :156   1st Qu.: 1376   > 1000 DM    : 32    0 - 1 yrs :109    
##  furniture :117   Median : 2324   101 - 500 DM : 69    1 - 4 yrs :228    
##  car (used): 71   Mean   : 3229   501 - 1000 DM: 40    4 - 7 yrs :123    
##  business  : 62   3rd Qu.: 3964   unknown      :125    unemployed: 45    
##  education : 30   Max.   :15857                                          
##  (Other)   : 37                                                          
##  installment_rate      personal_status      other_debtors residence_history
##  Min.   :1.000    divorced male: 36    co-applicant: 25   Min.   :1.000    
##  1st Qu.:2.000    female       :208    guarantor   : 40   1st Qu.:2.000    
##  Median :3.000    married male : 58    none        :601   Median :3.000    
##  Mean   :2.953    single male  :364                       Mean   :2.824    
##  3rd Qu.:4.000                                            3rd Qu.:4.000    
##  Max.   :4.000                                            Max.   :4.000    
##                                                                            
##                      property        age        installment_plan     housing   
##  building society savings:154   Min.   :19.00   bank  :102       for free: 73  
##  other                   :218   1st Qu.:27.00   none  :537       own     :475  
##  real estate             :199   Median :33.00   stores: 27       rent    :118  
##  unknown/none            : 95   Mean   :35.48                                  
##                                 3rd Qu.:42.00                                  
##                                 Max.   :74.00                                  
##                                                                                
##  existing_credits   dependents    telephone  foreign_worker
##  Min.   :1.000    Min.   :1.000   none:406   no : 24       
##  1st Qu.:1.000    1st Qu.:1.000   yes :260   yes:642       
##  Median :1.000    Median :1.000                            
##  Mean   :1.407    Mean   :1.153                            
##  3rd Qu.:2.000    3rd Qu.:1.000                            
##  Max.   :4.000    Max.   :2.000                            
##                                                            
##                       job          sex     
##  mangement self-employed: 86   female:208  
##  skilled employee       :427   male  :458  
##  unemployed non-resident: 16               
##  unskilled resident     :137               
##                                            
##                                            
## 
summary(train_y)
## No default    Default 
##        465        201
summary(test_X)
##    checking_balance months_loan_duration                credit_history
##  < 0 DM    : 87     Min.   : 4.00        critical              : 91   
##  > 200 DM  : 22     1st Qu.:12.00        delayed               : 32   
##  1 - 200 DM: 88     Median :18.00        fully repaid          : 11   
##  unknown   :137     Mean   :21.08        fully repaid this bank: 15   
##                     3rd Qu.:24.00        repaid                :185   
##                     Max.   :60.00                                     
##                                                                       
##        purpose       amount           savings_balance  employment_length
##  radio/tv  :87   Min.   :  276   < 100 DM     :203    > 7 yrs   : 92    
##  car (new) :78   1st Qu.: 1348   > 1000 DM    : 16    0 - 1 yrs : 63    
##  furniture :64   Median : 2300   101 - 500 DM : 34    1 - 4 yrs :111    
##  business  :35   Mean   : 3356   501 - 1000 DM: 23    4 - 7 yrs : 51    
##  car (used):32   3rd Qu.: 3986   unknown      : 58    unemployed: 17    
##  education :20   Max.   :18424                                          
##  (Other)   :18                                                          
##  installment_rate      personal_status      other_debtors residence_history
##  Min.   :1.000    divorced male: 14    co-applicant: 16   Min.   :1.000    
##  1st Qu.:2.000    female       :102    guarantor   : 12   1st Qu.:2.000    
##  Median :3.000    married male : 34    none        :306   Median :3.000    
##  Mean   :3.012    single male  :184                       Mean   :2.886    
##  3rd Qu.:4.000                                            3rd Qu.:4.000    
##  Max.   :4.000                                            Max.   :4.000    
##                                                                            
##                      property        age        installment_plan     housing   
##  building society savings: 78   Min.   :20.00   bank  : 37       for free: 35  
##  other                   :114   1st Qu.:27.00   none  :277       own     :238  
##  real estate             : 83   Median :32.50   stores: 20       rent    : 61  
##  unknown/none            : 59   Mean   :35.69                                  
##                                 3rd Qu.:41.75                                  
##                                 Max.   :75.00                                  
##                                                                                
##  existing_credits   dependents    telephone  foreign_worker
##  Min.   :1.000    Min.   :1.000   none:190   no : 13       
##  1st Qu.:1.000    1st Qu.:1.000   yes :144   yes:321       
##  Median :1.000    Median :1.000                            
##  Mean   :1.407    Mean   :1.159                            
##  3rd Qu.:2.000    3rd Qu.:1.000                            
##  Max.   :4.000    Max.   :2.000                            
##                                                            
##                       job          sex     
##  mangement self-employed: 62   female:102  
##  skilled employee       :203   male  :232  
##  unemployed non-resident:  6               
##  unskilled resident     : 63               
##                                            
##                                            
## 
summary(test_y)
## No default    Default 
##        235         99

Veiem que tots dos conjunts són molt similars, així que podem procedir a crear l’arbre de decisió.

2 Creació d’un arbre de decisió

En aquest apartat creem un arbre de decisió Quinlan C5.0. És un tipus d’algoritme de classificació que utilitza un arbre de decisió per prendre decisions basades en diferents atributs.

És una implementació d’un arbre de decisió que fa servir una tècnica anomenada “poda C4.5” per millorar la precisió de l’algoritme. Això es fa seleccionant els atributs més informatius per fer les decisions en cada node de l’arbre, en lloc de seleccionar atributs aleatòriament.

En primer lloc, carreguem el paquet C50:

packages <- c("C50")

not_installed <- packages[!(packages %in% installed.packages())]
if (length(not_installed) > 0) {
  install.packages(not_installed, repos = "http:/cran.us.r-project.org")
}
lapply(packages, library, character.only = TRUE)
## [[1]]
##  [1] "C50"       "corrplot"  "dplyr"     "gridExtra" "grid"      "ggpubr"   
##  [7] "ggtext"    "ggalt"     "ggplot2"   "stats"     "graphics"  "grDevices"
## [13] "utils"     "datasets"  "methods"   "base"

Ara creem el model utilitzant les dades d’entrenament:

c50_model <- C5.0(train_X, train_y, rules = TRUE)
summary(c50_model)
## 
## Call:
## C5.0.default(x = train_X, y = train_y, rules = TRUE)
## 
## 
## C5.0 [Release 2.07 GPL Edition]      Wed Dec 28 13:10:52 2022
## -------------------------------
## 
## Class specified by attribute `outcome'
## 
## Read 666 cases (22 attributes) from undefined.data
## 
## Rules:
## 
## Rule 1: (24/2, lift 1.3)
##  foreign_worker = no
##  ->  class No default  [0.885]
## 
## Rule 2: (642/199, lift 1.0)
##  foreign_worker = yes
##  ->  class No default  [0.689]
## 
## Rule 3: (14, lift 3.1)
##  checking_balance in {< 0 DM, 1 - 200 DM}
##  months_loan_duration > 24
##  credit_history = repaid
##  savings_balance in {< 100 DM, 101 - 500 DM}
##  installment_rate > 2
##  age > 27
##  job in {skilled employee, unskilled resident}
##  ->  class Default  [0.938]
## 
## Rule 4: (8, lift 3.0)
##  checking_balance in {< 0 DM, 1 - 200 DM}
##  credit_history = repaid
##  amount > 7824
##  other_debtors = none
##  ->  class Default  [0.900]
## 
## Rule 5: (7, lift 2.9)
##  credit_history = repaid
##  amount <= 1386
##  savings_balance = < 100 DM
##  installment_rate <= 2
##  other_debtors = none
##  telephone = none
##  ->  class Default  [0.889]
## 
## Rule 6: (28/3, lift 2.9)
##  checking_balance in {< 0 DM, > 200 DM, 1 - 200 DM}
##  credit_history = repaid
##  savings_balance in {< 100 DM, 101 - 500 DM}
##  employment_length in {0 - 1 yrs, 1 - 4 yrs, 4 - 7 yrs, unemployed}
##  installment_rate > 2
##  personal_status = female
##  other_debtors = none
##  job in {skilled employee, unskilled resident}
##  ->  class Default  [0.867]
## 
## Rule 7: (10/1, lift 2.8)
##  checking_balance in {< 0 DM, > 200 DM, 1 - 200 DM}
##  credit_history = delayed
##  savings_balance = < 100 DM
##  installment_rate > 2
##  other_debtors = none
##  ->  class Default  [0.833]
## 
## Rule 8: (10/1, lift 2.8)
##  checking_balance = unknown
##  months_loan_duration > 16
##  residence_history <= 2
##  installment_plan = bank
##  ->  class Default  [0.833]
## 
## Rule 9: (3, lift 2.7)
##  months_loan_duration > 42
##  other_debtors = guarantor
##  ->  class Default  [0.800]
## 
## Rule 10: (3, lift 2.7)
##  checking_balance = > 200 DM
##  age <= 36
##  job = unskilled resident
##  ->  class Default  [0.800]
## 
## Rule 11: (17/3, lift 2.6)
##  checking_balance in {< 0 DM, > 200 DM, 1 - 200 DM}
##  credit_history = fully repaid
##  savings_balance in {< 100 DM, 101 - 500 DM}
##  installment_plan = none
##  ->  class Default  [0.789]
## 
## Rule 12: (20/4, lift 2.6)
##  checking_balance in {< 0 DM, > 200 DM, 1 - 200 DM}
##  credit_history = fully repaid this bank
##  savings_balance in {< 100 DM, 101 - 500 DM}
##  foreign_worker = yes
##  ->  class Default  [0.773]
## 
## Rule 13: (2, lift 2.5)
##  credit_history = critical
##  installment_rate <= 2
##  other_debtors = guarantor
##  ->  class Default  [0.750]
## 
## Rule 14: (17/5, lift 2.3)
##  checking_balance in {< 0 DM, 1 - 200 DM}
##  savings_balance in {< 100 DM, 101 - 500 DM}
##  installment_rate > 2
##  personal_status in {divorced male, married male}
##  other_debtors = none
##  job in {skilled employee, unskilled resident}
##  ->  class Default  [0.684]
## 
## Rule 15: (409/240, lift 1.4)
##  checking_balance in {< 0 DM, > 200 DM, 1 - 200 DM}
##  ->  class Default  [0.414]
## 
## Default class: No default
## 
## 
## Evaluation on training data (666 cases):
## 
##          Rules     
##    ----------------
##      No      Errors
## 
##      15  103(15.5%)   <<
## 
## 
##     (a)   (b)    <-classified as
##    ----  ----
##     449    16    (a): class No default
##      87   114    (b): class Default
## 
## 
##  Attribute usage:
## 
##  100.00% foreign_worker
##   62.91% checking_balance
##   16.07% savings_balance
##   15.47% credit_history
##   11.11% installment_rate
##   11.11% other_debtors
##    8.71% job
##    6.76% personal_status
##    4.20% employment_length
##    4.05% months_loan_duration
##    4.05% installment_plan
##    2.55% age
##    2.25% amount
##    1.50% residence_history
##    1.05% telephone
## 
## 
## Time: 0.0 secs

Fem servir la funció summary(...) perquè ens retorni informació sobre el model que acabem de crear. Mostra la crida que l’ha creat, el nombre de registres i atributs que s’han fet servir, les 15 regles que ha generat i fa una petita avaluació del model amb les dades d’entrenament.

Veiem que s’equivoca en 103 dels 666 casos donats, és a dir, un 15,5 % dels casos. En la matriu es veu com 16 valors reals de “No default” han siguit classificats incorrectament com a “Default” (falsos positius), mentre que en 98 casos de “Default” han sigut incorrectament classificats com a “No default” (falsos negatius).

És possible que estiguem en un cas d’overfitting. Per això, és important avaluar els arbres de decisió fent servir el conjunt de dades de prova i comprovar si l’error que tenim és cert o massa baix.

2.1 Visualització de l’arbre

Ara podem visualitzar el model. Per a fer-ho, hem de treure l’argument rules:

c50_model <- C5.0(train_X, train_y)
plot(c50_model, gp = gpar(fontsize = 9.5))

Com que és un arbre amb moltes regles, es veu una imatge molt petita, però si hi cliquem amb el botó dret del ratolí i l’obrim en una pestanya nova es pot ampliar.

3 Explicació de les regles obtingudes

En aquest apartat s’hi fa una breu explicació de les regles obtingudes i s’estudia la importància de les variables.

Tenim un total de 15 regles. Cada regla mostrada anteriorment amb la comanda summary consisteix en:

Les primeres regles fan referència a la variable foreign_worker. Amb una confiança del 0.885 ens diu que si el treballador no és estranger, llavors paga el deute. En canvi, també mostra que si el treballador és estranger, amb una confiança de 0.689 també paga el deute. En aquest cas hi hauria un conflicte, així que s’agafaria la que té més confiança.

Hi ha una altra regla que determina amb una confiança de 0.900 que diu que si els diners al compte són inferiors a 200 DM i l’historial de crèdits diu que han sigut repaid i la quantitat del crèdit és de més de 7824 i no té altres deutors, llavors hi haurà un impagament.

Hi ha una regla amb molts casos d’entrenament coberts per la regla. Ens diu que si es coneixen els diners que té al compte corrent, llavors es pot afirmar amb una confiança del 0.414 que acabarà en impagament. És la regla amb menys confiança, però és per la que més casos d’entrenament hi passen.

La regla amb més confiança de totes ens diu que si té menys de 200 DM al compte corrent, la durada del crèdit és de més de 24 mesos, l’historial de crèdits diu que han sigut repaid, la quantitat d’estalvis està entre 0 i 500 DM, l’installment_rate és superior a 2, l’edat és superior a 27 i té feina, però no és autònom, llavors amb una confiança del 0.938 acabarà en impagament.

Com es pot veure, hi ha moltes regles compostes, això es deu a la quantitat de variables del dataset i a la poca relació que tenen entre elles.

Les regles compostes de moltes condicions és possible que estiguin fent overfitting, ja que, en algunes hi ha condicions que sembla que no tinguin gaire sentit. És un dels problemes de no tenir gaires dades. Amb un conjunt de dades amb més registres és possible que no passi tant.

Una altra mètrica que veiem en la sortida de la funció summary(..) és l’ús o importància dels atributs. Tenim una funció anomenada C5imp(...) que mostra la importància de cada atribut segons la mètrica escollida.

Quan s’utilitza la mètrica usage es calcula la importància a partir del percentatge de mostres del conjunt d’entrenament que acaben a un node terminal després de la divisió. D’aquesta manera, tenim que la primera variable en separar el conjunt té un valor de 100. A partir, d’aquesta, la resta tenen valors més xics.

imp_usage <- C5imp(c50_model, metric = "usage")
imp_usage
##                      Overall
## checking_balance      100.00
## foreign_worker         61.41
## other_debtors          59.16
## savings_balance        52.10
## credit_history         45.20
## installment_plan       41.74
## job                    20.72
## installment_rate       20.57
## amount                 19.22
## months_loan_duration   10.66
## personal_status        10.66
## telephone               5.41
## residence_history       4.80
## employment_length       4.50
## dependents              2.85
## age                     2.25
## housing                 0.60
## purpose                 0.00
## property                0.00
## existing_credits        0.00
## sex                     0.00

En aquest cas podem veure com l’atribut més important és foreign_worker i el segon és checking_balance. Hi ha un conjunt de variables que no es fan servir (purpose, property, housing, existing_credits, dependents i sex).

Quan es fa servir la mètrica splits la importància es calcula a partir del percentatge de separacions associades a cada variable.

imp_splits <- C5imp(c50_model, metric = "splits")
imp_splits
##                        Overall
## amount               10.000000
## installment_rate     10.000000
## months_loan_duration 10.000000
## savings_balance      10.000000
## age                   6.666667
## checking_balance      6.666667
## credit_history        6.666667
## installment_plan      6.666667
## job                   6.666667
## dependents            3.333333
## employment_length     3.333333
## foreign_worker        3.333333
## housing               3.333333
## other_debtors         3.333333
## personal_status       3.333333
## residence_history     3.333333
## telephone             3.333333
## purpose               0.000000
## property              0.000000
## existing_credits      0.000000
## sex                   0.000000

Podem veure diferències respecte de l’anterior mètrica, ja que, ara veiem com checking_balance és la variable més rellevant, seguida de credit_history. Per a trobar foreign_worker ens hem de desplaçar fins a la setena posició de la llista.

En la següent gràfica podem veure de forma clara la diferència entre alguns d’aquests atributs:

row_names <- sort(rownames(imp_usage))
imp_usage_sort <- imp_usage[order(rownames(imp_usage)), ]
imp_splits_sort <- imp_splits[order(rownames(imp_splits)), ]

df_imp <- data.frame(
  attribute = row_names,
  usage = imp_usage_sort,
  splits = imp_splits_sort
)
str(df_imp)
## 'data.frame':    21 obs. of  3 variables:
##  $ attribute: chr  "age" "amount" "checking_balance" "credit_history" ...
##  $ usage    : num  2.25 19.22 100 45.2 2.85 ...
##  $ splits   : num  6.67 10 6.67 6.67 3.33 ...
theme_set(theme_classic())

gg <- ggplot(
  df_imp,
  aes(x = splits, xend = usage, y = reorder(attribute, usage), group = 1)
) +
  geom_dumbbell(
    color = "#e3e2e1",
    colour_x = "#f2911b",
    colour_xend = "#4973f2",
    size = 1.5,
  ) +
  labs(
    x = NULL,
    y = NULL,
    title = "Gràfica Dumbbell",
    subtitle = "Diferència entre la importància dels atributs segons <span style='color: #f2911b;'>Splits</span> vs. <span style='color:#4973f2;'>Usage</span>"
  ) +
  theme_minimal() +
  theme(legend.position = "top") +
  theme(plot.subtitle = element_markdown()) +
  theme(panel.grid.major.x = element_line(size = 0.05))
plot(gg)

4 Avaluació amb el conjunt de proves

Com hem comentat anteriorment, cal comprovar que el model funciona correctament utilitzant les dades que encara no ha vist.

Això ho fem predient la variable default per a cada un dels registres del conjunt test_X. Després obtenim la precisió de l’arbre comprovant les prediccions amb els valors reals test_y:

predicted_model <- predict(c50_model, test_X, type = "class")
precision <- 100 * sum(predicted_model == test_y) / length(predicted_model)
print(sprintf("La precisió de l'arbre és de: %.4f %%", precision))
## [1] "La precisió de l'arbre és de: 76.0479 %"

Podem fer servir el paquet gmodels per a obtenir més informació. Primer de tot, l’instal·lem:

packages <- c("gmodels")

not_installed <- packages[!(packages %in% installed.packages())]
if (length(not_installed) > 0) {
  install.packages(not_installed, repos = "http:/cran.us.r-project.org")
}
lapply(packages, library, character.only = TRUE)
## [[1]]
##  [1] "gmodels"   "C50"       "corrplot"  "dplyr"     "gridExtra" "grid"     
##  [7] "ggpubr"    "ggtext"    "ggalt"     "ggplot2"   "stats"     "graphics" 
## [13] "grDevices" "utils"     "datasets"  "methods"   "base"

Ara cridem a la funció CrossTable(...) per a que mostri una matriu de confusió:

CrossTable(test_y, predicted_model,
  prop.chisq = FALSE, prop.c = FALSE, prop.r = FALSE,
  dnn = c("Reality", "Prediction")
)
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  334 
## 
##  
##              | Prediction 
##      Reality | No default |    Default |  Row Total | 
## -------------|------------|------------|------------|
##   No default |        210 |         25 |        235 | 
##              |      0.629 |      0.075 |            | 
## -------------|------------|------------|------------|
##      Default |         55 |         44 |         99 | 
##              |      0.165 |      0.132 |            | 
## -------------|------------|------------|------------|
## Column Total |        265 |         69 |        334 | 
## -------------|------------|------------|------------|
## 
## 

Veiem que el model s’equivoca més amb els casos que realment són “Default”, un 55,6 % els classifica com a “No default”. En canvi, els casos que realment són “No default” els classifica erròniament un 10,6 % dels cops.

La precisió del model es calcula de la següent forma: \[ Precisió = \frac{TP}{TP+FP} \] En aquest cas tenim que \(TP\) és igual al nombre de registres que eren “Default” i s’han predit com a “Default”. És a dir, 44. I \(FP\) és igual al nombre de registres que eren “Default” i s’han predit com a “No default”. És a dir, 25: \[ Precisió = \frac{44}{44+25} = 0,637 \] És a dir, quan prediu un impagament, és correcte un 63,7 % dels cops.

La sensibilitat del model es calcula de la següent forma: \[ Sensibilitat = \frac{TP}{TP+FN} \] En aquest cas tenim que \(FN\) és igual al nombre de registres que eren “No default”, però s’han predit com a “Default”. És a dir, 55: \[ Sensibilitat = \frac{44}{44+55} = 0,444 \] És a dir, identifica correctament el 44,4 % dels impagaments.

Ara podem calcular també la mesura F-measure, que s’obté amb la següent fórmula: \[ F-Measure = 2 \times \frac{Precisió \times Sensibilitat}{Precisió \times Sensibilitat} \] Apliquem la fórmula i ens dona: 0,261. Com que està bastant més a prop del 0 que de l’1 sabem que és un resultat dolent. Aquestà mètrica ens servirà més endavant quan volguem comparar amb nous models.

Gràcies a calcular aquestes mètriques sabem que aquest model no és capaç de determinar quan una persona que demana un crèdit el tornarà o no. A més, quan classifica un impagament no podem estar segurs que ho sigui. En canvi, si li entra una persona que retornarà el crèdit, és capaç d’encertar-ho amb una altra probabilitat.

Evidentment, aquest model no és gens útil per a usar-lo en producció. Un banc que implementi aquesta predicció s’arrisca al fet que no li retornin una gran quantitat de crèdits i, per tant, a perdre molts diners.

5 Models complementaris

Com s’ha explicat en l’apartat anterior, el model actual no és gens bo. Per la qual cosa, ens veiem obligats a buscar alternatives que el millorin.

En aquest apartat es busca millorar el model canviant alguns paràmetres però mantenint l’algorisme Quinlan C5.0.

També es proven altres tipus d’arbres per a veure com es comparen els models obtinguts.

5.1 Variacions del Quinlan C5.0

Una forma de millorar el model actual és mitjançant adaptive boosting. Bàsicament, consisteix a agregar les prediccions de múltiples predictors per a aconseguir millors prediccions. En aquest cas, es construeixen diversos arbres de decisió i els arbres decideixen quina és la millor classe per a cada registre.

Per afegir aquesta funcionalitat a l’arbre C5.0 només hem d’utilitzar el paràmetre trials. Aquest indica el nombre d’arbres diferents que es generen. D’entrada comencem amb 10 trials, però es pot anar provant diversos valors:

c50_model_10 <- C5.0(train_X, train_y, trials = 10)
plot(c50_model_10)

Comprovem amb la precisió i F-measure si hem millorat el model:

calculate_f_measure <- function(model, test_X, test_y) {
  predicted_model <- predict(model, test_X, type = "class")
  precision <- 100 * sum(predicted_model == test_y) / length(predicted_model)
  print(sprintf("La precisió de l'arbre és de: %.4f %%", precision))

  cross_table <- CrossTable(test_y, predicted_model,
    prop.chisq = FALSE, prop.c = FALSE, prop.r = FALSE,
    dnn = c("Reality", "Prediction")
  )

  precisio <- cross_table$prop.col[2, 2]
  sensibilitat <- cross_table$prop.row[2, 2]

  f_measure <- (precisio * sensibilitat) / (precisio + sensibilitat)
  return(f_measure)
}

f_measure <- calculate_f_measure(c50_model_10, test_X, test_y)
## [1] "La precisió de l'arbre és de: 75.4491 %"
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  334 
## 
##  
##              | Prediction 
##      Reality | No default |    Default |  Row Total | 
## -------------|------------|------------|------------|
##   No default |        208 |         27 |        235 | 
##              |      0.623 |      0.081 |            | 
## -------------|------------|------------|------------|
##      Default |         55 |         44 |         99 | 
##              |      0.165 |      0.132 |            | 
## -------------|------------|------------|------------|
## Column Total |        263 |         71 |        334 | 
## -------------|------------|------------|------------|
## 
## 
print(f_measure)
## [1] 0.2588235

Veiem com no només no hem millorat, sinó que hem empitjorat. Provem amb altres valors de trials:

trials_values <- c(5, 20, 30, 50, 60, 75, 85, 100)

for (trial in trials_values) {
  model_aux <- C5.0(train_X, train_y, trials = trial)
  f_measure <- calculate_f_measure(c50_model_10, test_X, test_y)
  print(paste("Trial:", trial, "F-measure:", f_measure))
}
## [1] "La precisió de l'arbre és de: 75.4491 %"
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  334 
## 
##  
##              | Prediction 
##      Reality | No default |    Default |  Row Total | 
## -------------|------------|------------|------------|
##   No default |        208 |         27 |        235 | 
##              |      0.623 |      0.081 |            | 
## -------------|------------|------------|------------|
##      Default |         55 |         44 |         99 | 
##              |      0.165 |      0.132 |            | 
## -------------|------------|------------|------------|
## Column Total |        263 |         71 |        334 | 
## -------------|------------|------------|------------|
## 
##  
## [1] "Trial: 5 F-measure: 0.258823529411765"
## [1] "La precisió de l'arbre és de: 75.4491 %"
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  334 
## 
##  
##              | Prediction 
##      Reality | No default |    Default |  Row Total | 
## -------------|------------|------------|------------|
##   No default |        208 |         27 |        235 | 
##              |      0.623 |      0.081 |            | 
## -------------|------------|------------|------------|
##      Default |         55 |         44 |         99 | 
##              |      0.165 |      0.132 |            | 
## -------------|------------|------------|------------|
## Column Total |        263 |         71 |        334 | 
## -------------|------------|------------|------------|
## 
##  
## [1] "Trial: 20 F-measure: 0.258823529411765"
## [1] "La precisió de l'arbre és de: 75.4491 %"
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  334 
## 
##  
##              | Prediction 
##      Reality | No default |    Default |  Row Total | 
## -------------|------------|------------|------------|
##   No default |        208 |         27 |        235 | 
##              |      0.623 |      0.081 |            | 
## -------------|------------|------------|------------|
##      Default |         55 |         44 |         99 | 
##              |      0.165 |      0.132 |            | 
## -------------|------------|------------|------------|
## Column Total |        263 |         71 |        334 | 
## -------------|------------|------------|------------|
## 
##  
## [1] "Trial: 30 F-measure: 0.258823529411765"
## [1] "La precisió de l'arbre és de: 75.4491 %"
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  334 
## 
##  
##              | Prediction 
##      Reality | No default |    Default |  Row Total | 
## -------------|------------|------------|------------|
##   No default |        208 |         27 |        235 | 
##              |      0.623 |      0.081 |            | 
## -------------|------------|------------|------------|
##      Default |         55 |         44 |         99 | 
##              |      0.165 |      0.132 |            | 
## -------------|------------|------------|------------|
## Column Total |        263 |         71 |        334 | 
## -------------|------------|------------|------------|
## 
##  
## [1] "Trial: 50 F-measure: 0.258823529411765"
## [1] "La precisió de l'arbre és de: 75.4491 %"
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  334 
## 
##  
##              | Prediction 
##      Reality | No default |    Default |  Row Total | 
## -------------|------------|------------|------------|
##   No default |        208 |         27 |        235 | 
##              |      0.623 |      0.081 |            | 
## -------------|------------|------------|------------|
##      Default |         55 |         44 |         99 | 
##              |      0.165 |      0.132 |            | 
## -------------|------------|------------|------------|
## Column Total |        263 |         71 |        334 | 
## -------------|------------|------------|------------|
## 
##  
## [1] "Trial: 60 F-measure: 0.258823529411765"
## [1] "La precisió de l'arbre és de: 75.4491 %"
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  334 
## 
##  
##              | Prediction 
##      Reality | No default |    Default |  Row Total | 
## -------------|------------|------------|------------|
##   No default |        208 |         27 |        235 | 
##              |      0.623 |      0.081 |            | 
## -------------|------------|------------|------------|
##      Default |         55 |         44 |         99 | 
##              |      0.165 |      0.132 |            | 
## -------------|------------|------------|------------|
## Column Total |        263 |         71 |        334 | 
## -------------|------------|------------|------------|
## 
##  
## [1] "Trial: 75 F-measure: 0.258823529411765"
## [1] "La precisió de l'arbre és de: 75.4491 %"
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  334 
## 
##  
##              | Prediction 
##      Reality | No default |    Default |  Row Total | 
## -------------|------------|------------|------------|
##   No default |        208 |         27 |        235 | 
##              |      0.623 |      0.081 |            | 
## -------------|------------|------------|------------|
##      Default |         55 |         44 |         99 | 
##              |      0.165 |      0.132 |            | 
## -------------|------------|------------|------------|
## Column Total |        263 |         71 |        334 | 
## -------------|------------|------------|------------|
## 
##  
## [1] "Trial: 85 F-measure: 0.258823529411765"
## [1] "La precisió de l'arbre és de: 75.4491 %"
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  334 
## 
##  
##              | Prediction 
##      Reality | No default |    Default |  Row Total | 
## -------------|------------|------------|------------|
##   No default |        208 |         27 |        235 | 
##              |      0.623 |      0.081 |            | 
## -------------|------------|------------|------------|
##      Default |         55 |         44 |         99 | 
##              |      0.165 |      0.132 |            | 
## -------------|------------|------------|------------|
## Column Total |        263 |         71 |        334 | 
## -------------|------------|------------|------------|
## 
##  
## [1] "Trial: 100 F-measure: 0.258823529411765"

Estem obtenint tota l’estona els mateixos resultats. No acabem d’entendre el perquè. Un dels motius podria ser la manca de dades.

5.2 Entrenar amb menys atributs

Una altra possibilitat pel qual no estem assolint bons resultats pot ser que les dades siguin molt complexes i que el model intenti ajustar-s’hi massa.

Podem provar de treure del conjunt d’entrenament els atributs que en anteriors models hem vist que no tenen gaire importància.

Primer de tot, seleccionem els atributs amb més importància:

usage_threshold <- 10
splits_threshold <- 6
most_imp <- df_imp$attribute[
  df_imp$usage > usage_threshold |
    df_imp$splits > splits_threshold
]
test_imp_X <- test_X[most_imp]
train_imp_X <- train_X[most_imp]

Ara procedim a entrenar el model:

c50_model_imp <- C5.0(train_imp_X, train_y)
plot(c50_model_imp)

Avaluem el model:

f_measure <- calculate_f_measure(c50_model_imp, test_imp_X, test_y)
## [1] "La precisió de l'arbre és de: 77.8443 %"
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  334 
## 
##  
##              | Prediction 
##      Reality | No default |    Default |  Row Total | 
## -------------|------------|------------|------------|
##   No default |        218 |         17 |        235 | 
##              |      0.653 |      0.051 |            | 
## -------------|------------|------------|------------|
##      Default |         57 |         42 |         99 | 
##              |      0.171 |      0.126 |            | 
## -------------|------------|------------|------------|
## Column Total |        275 |         59 |        334 | 
## -------------|------------|------------|------------|
## 
## 
print(f_measure)
## [1] 0.2658228

La F-measure és de 0.2658228, així que tenim uns resultats molt similars als anteriors.

5.3 Random Forest

Un altre tipus d’algorisme basat en arbres que es pot provar és Random Forest. Aquest es basa en crear molts arbres de decisió diferents i fer-los servir per a prendre decisions en conjunt.

Primer de tot, carreguem el paquet randomForest:

packages <- c("randomForest")

not_installed <- packages[!(packages %in% installed.packages())]
if (length(not_installed) > 0) {
  install.packages(not_installed, repos = "http:/cran.us.r-project.org")
}
lapply(packages, library, character.only = TRUE)
## [[1]]
##  [1] "randomForest" "gmodels"      "C50"          "corrplot"     "dplyr"       
##  [6] "gridExtra"    "grid"         "ggpubr"       "ggtext"       "ggalt"       
## [11] "ggplot2"      "stats"        "graphics"     "grDevices"    "utils"       
## [16] "datasets"     "methods"      "base"

A continuació, es pot crear el nou model amb la funció randomForest:

rf_model <- randomForest(x = train_X, y = train_y, ntree = 10000)

Ara avaluem el model fent servir la funció creada anteriorment:

f_measure <- calculate_f_measure(rf_model, test_X, test_y)
## [1] "La precisió de l'arbre és de: 79.9401 %"
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  334 
## 
##  
##              | Prediction 
##      Reality | No default |    Default |  Row Total | 
## -------------|------------|------------|------------|
##   No default |        227 |          8 |        235 | 
##              |      0.680 |      0.024 |            | 
## -------------|------------|------------|------------|
##      Default |         59 |         40 |         99 | 
##              |      0.177 |      0.120 |            | 
## -------------|------------|------------|------------|
## Column Total |        286 |         48 |        334 | 
## -------------|------------|------------|------------|
## 
## 
print(f_measure)
## [1] 0.2721088

Tot i que ara tenim una F-measure millor (0.2721088), no es pot considerar que els resultats hagin millorat gaire. Però, cal destacar que amb aquest model la precisió, és a dir, la probabilitat que s’hagi predit correctament un impagament és més alta. Concretament és del 83,6 %. Malauradament, la sensibilitat és molt baixa (41,4 %).

6 Conclusions

6.1 Interpretació de les variables en les prediccions

En aquesta secció tornem a executar una anàlisi de la influència de les variables, però utilitzant un altre mètode. Ens ha de servir per acabar de conèixer els atributs del conjunt de dades i com es fan servir en els models basats en arbres.

Instal·lem el paquet iml, que ens donarà les mètriques interpretabilitat:

packages <- c("iml", "patchwork")

not_installed <- packages[!(packages %in% installed.packages())]
if (length(not_installed) > 0) {
  install.packages(not_installed, repos = "http:/cran.us.r-project.org")
}
lapply(packages, library, character.only = TRUE)
## [[1]]
##  [1] "iml"          "randomForest" "gmodels"      "C50"          "corrplot"    
##  [6] "dplyr"        "gridExtra"    "grid"         "ggpubr"       "ggtext"      
## [11] "ggalt"        "ggplot2"      "stats"        "graphics"     "grDevices"   
## [16] "utils"        "datasets"     "methods"      "base"        
## 
## [[2]]
##  [1] "patchwork"    "iml"          "randomForest" "gmodels"      "C50"         
##  [6] "corrplot"     "dplyr"        "gridExtra"    "grid"         "ggpubr"      
## [11] "ggtext"       "ggalt"        "ggplot2"      "stats"        "graphics"    
## [16] "grDevices"    "utils"        "datasets"     "methods"      "base"

Primer, creem un nou model amb Random Forest. Podem mesurar la rellevància de cada variable amb la funció FeatureImp(...). La mesura es basa en funcions de pèrdua de rendiment com “ce”:

rf <- randomForest(default ~ ., data = df_original, ntree = 50)

X <- df_original[which(names(df_original) != "default")]
predictor <- Predictor$new(rf, data = df_original, y = "default")
imp_ce <- FeatureImp$new(predictor, loss = "ce")
plot(imp_ce)

Segons aquest gràfic, les variables més importants són checking_balance, age i amount. I les menys rellevants són dependents, foreign_worker i telephone.

6.2 Conclusions de les dades

Ara que ja hem arribat al final del treball podem concloure que segurament el conjunt de dades no és prou ampli per a fer-ho servir amb models basats en arbres. Estaria bé tenir més registres que aportessin més varietat a les dades.

Com ja s’ha comentat, és curiós el biaix que hi ha respecte als treballadors estrangers. Estaria bé obtenir més registres de treballadors locals per a estudiar si el comportament és diferent.

També seria important tenir dades sobre l’estat familiar de les dones.

Durant el projecte s’ha vist que les variables més importants són checking_balance, age, amount, credit_history i foreign_worker. Moltes d’elles ja les havíem intuït en l’anàlisi prèvia.

6.3 Conclusions dels models

No es pot considerar que cap dels models aconseguits pugui fer-se servir en el món real.

Els arbres de decisió són molt pràctics per què són capaços de predir variables i alhora és fàcil explicar el seu funcionament. Malgrat tot, en aquest cas no la seua senzillesa no ens ha servit.

És possible que amb un tractament diferent de les dades i amb un estudi més extens dels paràmetres de cada algorisme s’hagin pogut assolir millors resultats. Tot i això, no creiem que la diferència sigui molt elevada.